grammar TreeConstruction;

options {
  language = Java;
  output = AST;
//  backtrack = true;
}

tokens {
  MODULE;
  PROC_DECL;
  ARG_DECL;
  ARG_DECL_PT;
  VAR_DECL;
  TYPE_DECL;
  CONST_DECL;
  EXPR;
  ELIST;
  STAT;
  INDEX;
  CALL;
  CALLSTMT;
  RET_TYPE;
  PRINT;
  SEQUENCE;
  BUILTINFUNC;
  PROCEDURE;
  IF;
  CHARCONST;
  STRCONST;
  BOOLCONST;
  BYTECONST;
  SHORTCONST;
  INTCONST;
  LINTCONST;
  REALCONST;
  LREALCONST;
  OR;
  VAR;
  VAR_PT;
}

@header
{
  package ru.msu.cmc.sp.oberon2;
  import ru.msu.cmc.sp.oberon2.InterAST;
  import ru.msu.cmc.sp.oberon2.exceptions.*;
}

@lexer::header 
{
  package ru.msu.cmc.sp.oberon2;
  import ru.msu.cmc.sp.oberon2.exceptions.*;
}

@members {
InterAST node;
  public void reportError(RecognitionException e)
  {
    throw new RecognitionError(e.line, e.charPositionInLine, "Unknown token " + e.token.getText());
  }
}

@lexer::members {
  public void reportError(RecognitionException e)
  {
    throw new RecognitionError(e.line, e.charPositionInLine, "Unknown symbol " + e.token.getText());
  }
}

obmodule:  'MODULE' i=IDENT SEMICOLON importList? declarationSequence
    ('BEGIN' statementSequence)? 'END' IDENT DOT -> ^(MODULE[i] importList? declarationSequence? statementSequence?);

identdef : IDENT (STAR)?;
qualident :
      (s=IDENT DOT)? a=IDENT
      ->{s == null}? $a
      -> IDENT[$s, $s.text + "." + $a.text];
constantDeclaration  :  qualidentP EQUAL constExpression -> ^(CONST_DECL qualidentP constExpression);
constExpression  :  expression;
typeDeclaration  :  identdef EQUAL type -> ^(TYPE_DECL type identdef) ;
type  :  qualident | arrayType | procedureType;
arrayType  :  'ARRAY' (length)? 'OF' type -> ^(ARRAY (length)? type);
length  :  constExpression;

identList  :  identdef (COMMA identdef)* -> identdef+;

procedureType : 'PROCEDURE' (formalParametersPT)? -> ^(PROCEDURE (formalParametersPT)?);
variableDeclaration  :  identList COLON type -> ^(VAR_DECL type identList);
qualidentP :
    (s=IDENT DOT)? a=IDENT (STAR)?
      ->{s == null}? $a
      -> IDENT[$a, $s.text + "." + $a.text];
arraydesignator : qualident LBR expression RBR -> ^(INDEX qualident expression);
designator : qualident  // (/*DOT IDENT | LBR expr RBR |*/ LPAREN qualident RPAREN | REF)*
        | arraydesignator;
//designator  :  qualident ( REF? LBR expression RBR -> ^(INDEX qualident expression))?;
expList  :  expression? (COMMA expression)* -> ^(ELIST expression*);
expression
  : expr -> ^(EXPR expr);  
expr :  simpleExpression (relation^ simpleExpression)?;
relation  :  EQUAL | NEQUAL | LESS | LEQ | GREATER | GEQ | 'IN' | 'IS';

simpleExpression : sterm (addOperator^ term )*;
addOperator  :  PLUS | MINUS | 'OR' -> OR;

sterm :
  term |   
  PLUS! term |
  MINUS term -> ^(MINUS ^(INTCONST INTEGER["0"]) term);

term : factor (mulOperator^ factor )*;
mulOperator  :  STAR | SLASH | 'DIV' | 'MOD' | AMP ;
factor 
  : number
  | charconstant
  | string
  | boolconstant
  | 'NIL'
  | builtin
  | designator actualParameters?
  | LPAREN! expression RPAREN!
  | TILDE factor
  ;

actualParameters  :  LPAREN! (expList) RPAREN! ;

statement  :  ( 
        forStatement |
        ifStatement | caseStatement | whileStatement | repeatStatement |
        loopStatement | withStatement | 'EXIT' | 'RETURN'^ (expression)? )? |
        //builtinproc |
         designator ASSIGN expression -> ^(ASSIGN designator expression)  |  
         qualident (actualParameters)? -> ^(CALLSTMT qualident actualParameters?) ;

builtin : 'MAX' LPAREN type RPAREN -> ^(BUILTINFUNC 'MAX' type) |
          'MIN' LPAREN type RPAREN -> ^(BUILTINFUNC 'MIN' type) |
          'SIZE' LPAREN type RPAREN -> ^(BUILTINFUNC 'SIZE' type) |
          'VAL' LPAREN type COMMA expression RPAREN -> ^(BUILTINFUNC 'VAL' type expression) | 
          'ABS' LPAREN expression RPAREN  -> ^(BUILTINFUNC 'ABS' expression) |
          'ASH'   LPAREN expression COMMA expression RPAREN -> ^(BUILTINFUNC 'ASH' expression expression) |
          'CHR'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'CHR' expression) |
          'ENTIER'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'ENTIER' expression) |
          'EVEN'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'EVEN' expression) |
          'LEN'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'LEN' expression) |
          'LSH'   LPAREN expression COMMA expression  RPAREN -> ^(BUILTINFUNC 'LSH' expression expression) |
          'ODD'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'ODD' expression) |
          'ORD'   LPAREN expression RPAREN -> ^(BUILTINFUNC 'ORD' expression) ;

assignment  :  ASSIGN expression;
procedureCall  :  (actualParameters)?;
statementSequence  :  statement (SEMICOLON statement)* -> ^(SEQUENCE statement*);
ifStatement :
    'IF' expression 'THEN' statementSequence ifTemp
      -> ^(IF expression statementSequence ifTemp);

ifTemp :
    'ELSIF' expression 'THEN' statementSequence ifTemp
      -> ^(IF expression statementSequence ifTemp)
    | 'ELSE' statementSequence 'END' -> statementSequence
    | 'END';
    
    
    
    
caseStatement :
    'CASE' e=expression {
        node = (InterAST)e.getTree();
    } 'OF' a=obcase[node] b=caseBody[node]
      -> {a != null}? ^('CASE' ^(IF $a $b))
      -> ^('CASE' $b);

caseBody[InterAST node] :
    STROKE a=obcase[$node] b=caseBody[$node]
      ->^(IF $a $b)
    | 'ELSE' statementSequence 'END'
      -> statementSequence
    | 'END';

obcase[InterAST node] :
    b=caseLabelList[$node] COLON c=statementSequence
      -> $b $c;

caseLabelList[InterAST node] :
    (a=caseLabels[$node] -> $a)
    (COMMA b=caseLabels[$node] -> ^(OR $caseLabelList $b))*;
    
caseLabels[InterAST node] :
    a=constExpression (DOT DOT b=constExpression)?
      -> {b != null}? ^(AMP ^(GEQ {$node} $a) ^(LEQ {$node} $b))
      -> ^(EXPR ^(EQUAL {$node} $a));



whileStatement  :  'WHILE' expression 'DO' statementSequence 'END'
    -> ^('WHILE' expression statementSequence);
    
repeatStatement  :  'REPEAT' statementSequence 'UNTIL' expression
    -> ^('REPEAT' expression statementSequence);
    
loopStatement  :  'LOOP' statementSequence 'END'
    -> ^('LOOP' statementSequence);
    
withStatement  :  'WITH' qualident COLON qualident 'DO' statementSequence 'END' ;

forStatement :
    'FOR' designator ASSIGN expression
    'TO' expression
    forTail
      -> ^('FOR'  ^(ASSIGN designator expression) expression forTail);
forTail :
    'BY' expression forSequence -> expression forSequence
    | forSequence -> INTEGER["1"] forSequence;
forSequence : 'DO'! statementSequence 'END'!;

procedureDeclaration  :  
  procedureHeading SEMICOLON procedureBody qualidentP -> ^(PROC_DECL procedureHeading procedureBody);
procedureHeading  :  'PROCEDURE'! (STAR)? qualidentP (formalParameters)?;
procedureBody  :  declarationSequence ('BEGIN' statementSequence)? 'END' -> declarationSequence?  statementSequence?;
forwardDeclaration  :  'PROCEDURE' REF IDENT (STAR)? (formalParameters)?;
declarationSequence  :  ('###'! (declarationVAR|declarationTYPE|declarationCONST)* (procedureDeclaration SEMICOLON!)* '###'!)* declarationALL? 
    (procedureDeclaration SEMICOLON! | forwardDeclaration SEMICOLON!)*;
declarationALL : (declarationVAR|declarationTYPE|declarationCONST)+;
declarationTYPE : 'TYPE' (typeDeclaration SEMICOLON)* -> ^('TYPE' typeDeclaration*);
declarationCONST : 'CONST' (constantDeclaration SEMICOLON)* -> ^('CONST' constantDeclaration*);
declarationVAR : 
  'VAR' (variableDeclaration SEMICOLON)* -> variableDeclaration*;
formalParameters  :  LPAREN (fPSection (SEMICOLON fPSection)*)? RPAREN (COLON qualident)? -> fPSection* ^(RET_TYPE qualident)?;
fPSection  : 
    (n='VAR')? IDENT (COMMA IDENT)* COLON formalType
      ->{n == null}? ^(ARG_DECL formalType IDENT+)
      -> ^(VAR formalType IDENT+);

formalParametersPT :
    LPAREN (fPSectionPT (SEMICOLON fPSectionPT)*)? RPAREN (COLON qualident)? -> fPSectionPT* ^(RET_TYPE qualident)?;
    
fPSectionPT  :
    (n='VAR')? IDENT (COMMA IDENT)* COLON formalType
      ->{n == null}? ^(ARG_DECL_PT formalType IDENT+)
      -> ^(VAR_PT formalType IDENT+);
    
formalType  :  ('ARRAY'^ 'OF'!)* (qualident | procedureType);
importList  :  'IMPORT' obimprt (COMMA obimprt)* SEMICOLON! ;
obimprt  :  IDENT (ASSIGN IDENT)?;

number
@init {int type = 4;}:  i=INTEGER {
       long x = Long.parseLong($i.text);
       if (x >= -2147483648 && x <= 2147483647) type = 3;
       if (x >= -32768 && x <= 32767) type = 2;
       //if (x >= -256 && x <= 255) type = 1;
      } 
      -> {type == 4}? ^(LINTCONST INTEGER)
      -> {type == 3}? ^(INTCONST INTEGER) 
      -> {type == 2}? ^(SHORTCONST INTEGER)
      -> ^(BYTECONST INTEGER)
      | REAL -> ^(REALCONST REAL);
charconstant : CHAR -> ^(CHARCONST CHAR);
boolconstant  
  : BOOLEAN -> ^(BOOLCONST BOOLEAN);
  
string  :  STRING -> ^(STRCONST STRING);

//baseType: TBYTE^ | TBOOLEAN^ | TCHAR^ | TSHORTINT^ | TINTEGER^ | TLONGINT^ | TREAL^ | TLONGREAL^;
//TBOOLEAN : 'BOOLEAN';
//TCHAR : 'CHAR';
//TSHORTINT : 'SHORTINT';
//TINTEGER : 'INTEGER'; 
//TLONGINT : 'LONGINT';
//TREAL : 'REAL';
//TLONGREAL : 'LONGREAL';
//TBYTE : 'BYTE';

STAR : '*' ;
DOT : '.' ;
EQUAL : '=' ;
COMMA : ',' ;
SEMICOLON : ';' ;
LPAREN : '(' ;
RPAREN : ')' ;
COLON : ':' ;
DOTDOT : '..' ;
LBR : '[' ;
RBR : ']' ;
REF : '^' ;
LBRACE : '{' ;
RBRACE : '}' ;
NEQUAL : '#' ;
LESS : '<' ;
LEQ : '<=' ;
GREATER : '>' ;
GEQ : '>=' ;
PLUS : '+' ;
MINUS : '-' ;
SLASH : '/' ;
AMP : '&' ;
TILDE : '~' ;
STROKE : '|' ;
ASSIGN : ':=' ;
COMMENT : '(*' .* '*)' { $channel = HIDDEN; };
ARRAY : 'ARRAY';

BOOLEAN : 'TRUE' | 'FALSE';

IDENT : LETTER ( LETTER | DIGIT) * ;
CHAR : '\''  (~('\'')) '\'';
STRING:  '\"'  (~('\"'))* '\"' | '\''  (~('\''))+ '\'';
INTEGER :  DIGIT+ | DIGIT (HEXDIGIT)* 'H';
REAL : ( DIGIT ) + '.' ( DIGIT ) * ( DEGREE )? ;
DEGREE : ('E' | 'D') ('+' | '-')? DIGIT (DIGIT)*;

fragment SYMBOL: ~( '\\' | '\r' | '\n' );
fragment DIGIT: '0'..'9';
fragment HEXDIGIT: DIGIT | 'A' | 'B' | 'C' | 'D' | 'E' | 'F';
fragment LETTER : 'A' .. 'Z' | 'a' .. 'z' | '_' ;

WS : ( ' ' | '\t' | '\r' | '\u000C')+ { $channel = HIDDEN; } ;
NL : '\n' { $channel = HIDDEN; } ; 